perm filename MLIST.F4[CMS,LCS] blob
sn#092543 filedate 1974-03-19 generic text, type T, neo UTF8
00100 COMMON JA
00200 DIMENSION JA(11,200),JB(7,200),JC(7,200),JD(7,200),JE(7,200),
00300 1 NA(11)
00400 102 U=0
00500 8 K=0
00600 NB=0
00700 TYPE 6
00800 6 FORMAT(' NEW FILE OR OLD?'/)
00900 ACCEPT 10,M
01000 IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
01100 TYPE 22
01200 22 FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG.'/)
01300 ACCEPT 23,F
01400 23 FORMAT(A5)
01500 IF(F.EQ.' ')GO TO 8
01600 IF(M.EQ.'O')GO TO 43
01700 10 FORMAT(A1)
01800 15 TYPE 7
01900 7 FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2,3 AND 4,'/
02000 1 ' AND UP TO 7 ONE LETTER LIST NAMES ON LINE 5.'/)
02100 NB=1
02200 2 K=K+1
02300 TYPE 3
02400 3 FORMAT(' IF FINISHED TYPE <CR>.'//)
02500 ACCEPT 9,(JA(I,K),I=1,11)
02600 9 FORMAT(5A1,6A5)
02700 IF(JA(1,K).EQ.' ')GO TO 33
02800 ACCEPT 11,(JB(I,K),I=1,7)
02900 11 FORMAT(7A5)
03000 ACCEPT 11,(JC(I,K),I=1,7)
03100 ACCEPT 11,(JE(I,K),I=1,7)
03200 ACCEPT 20,(JD(I,K),I=1,7)
03300 20 FORMAT(7A1)
03400 GO TO 2
03500 43 IF(LOOKD(F))GO TO 44
03600 TYPE 58,F
03700 58 FORMAT(1XA5,' FILE NOT FOUND.'/)
03800 GO TO 102
03900 44 REWIND 1
04000 CALL IFILE(1,F)
04100 READ(1)K,((JB(I,L),I=1,7),L=1,K)
04200 READ(1)((JA(I,L),I=1,11),L=1,K)
04300 READ(1)((JC(I,L),I=1,7),L=1,K)
04400 READ(1)((JE(I,L),I=1,7),L=1,K)
04500 READ(1)((JD(I,L),I=1,7),L=1,K),K
04600 134 TYPE 66
04700 66 FORMAT(' TYPE ADD,CHANGE,DELEAT OR <CR> FOR PRINTOUT.'/)
04800 ACCEPT 10,P
04900 IF(P.EQ.'A')GO TO 15
05000 IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
05100 110 TYPE 111
05200 111 FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
05300 ACCEPT 9,(NA(I),I=1,11)
05400 IF(NA(1).EQ.' ')GO TO 134
05500 DO 114 N=1,K
05600 J=0
05700 DO 114 I=1,11
05800 IF(JA(I,N).EQ.NA(I))J=J+1
05900 IF(J.EQ.11)GO TO 148
06000 114 CONTINUE
06100 TYPE 116
06200 116 FORMAT(' NAME NOT FOUND.'/)
06300 GO TO 134
06400 148 IF(P.EQ.'D')GO TO 149
06500 NB=1
06600 TYPE 117
06700 117 FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
06800 ACCEPT 9,(NA(I),I=1,11)
06900 IF(NA(1).EQ.' ')GO TO 119
07000 DO 131 I=1,11
07100 131 JA(I,N)=NA(I)
07200 119 TYPE 136,(JB(I,N),I=1,7)
07300 TYPE 121
07400 121 FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
07500 ACCEPT 11,(NA(I),I=1,7)
07600 136 FORMAT(1X7A5)
07700 IF(NA(1).EQ.' ')GO TO 122
07800 DO 123 I=1,7
07900 123 JB(I,N)=NA(I)
08000 122 TYPE 136,(JC(I,N),I=1,7)
08100 TYPE 121
08200 ACCEPT 11,(NA(I),I=1,7)
08300 IF(NA(1).EQ.' ')GO TO 300
08400 DO 125 I=1,7
08500 125 JC(I,N)=NA(I)
08600 300 TYPE 136,(JE(I,N),I=1,7)
08700 TYPE 121
08800 ACCEPT 11,(NA(I),I=1,7)
08900 IF(NA(1).EQ.' ')GO TO 124
09000 DO 301 I=1,7
09100 301 JE(I,N)=NA(I)
09200 124 TYPE 137,(JD(I,N),I=1,7)
09300 137 FORMAT(1X7A1)
09400 TYPE 127
09500 127 FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
09600 ACCEPT 20,(NA(I),I=1,7)
09700 IF(NA(1).EQ.' ')GO TO 134
09800 DO 129 I=1,7
09900 129 JD(I,N)=NA(I)
10000 GO TO 134
10100 33 K=K-1
10200 P=' '
10300 146 IF(NB.EQ.0)GO TO 132
10400 104 DO 5 N=1,K-1
10500 IF(LN(N).LE.LN(N+1))GO TO 5
10600 DO 27 I=1,11
10700 27 JA(I,K+1)=JA(I,N)
10800 DO 133 I=1,7
10900 JB(I,K+1)=JB(I,N)
11000 JC(I,K+1)=JC(I,N)
11100 JE(I,K+1)=JE(I,N)
11200 133 JD(I,K+1)=JD(I,N)
11300 149 DO 82 J=N,K
11400 DO 26 I=1,11
11500 26 JA(I,J)=JA(I,J+1)
11600 DO 47 I=1,7
11700 JB(I,J)=JB(I,J+1)
11800 JC(I,J)=JC(I,J+1)
11900 JE(I,J)=JE(I,J+1)
12000 47 JD(I,J)=JD(I,J+1)
12100 82 CONTINUE
12200 IF(P.NE.'D')GO TO 104
12300 K=K-1
12400 NB=NB+NB
12500 GO TO 134
12600 5 CONTINUE
12700 132 REWIND 1
12800 CALL OFILE(1,F)
12900 WRITE(1)K,((JB(I,L),I=1,7),L=1,K),K
13000 WRITE(1)((JA(I,L),I=1,11),L=1,K),K
13100 WRITE(1)((JC(I,L),I=1,7),L=1,K),K
13200 WRITE(1)((JE(I,L),I=1,7),L=1,K),K
13300 WRITE(1)((JD(I,L),I=1,7),L=1,K),K,K
13400 END FILE 1
13500 60 TYPE 77
13600 77 FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
13700 ACCEPT 10,JF
13800 Y=' '
13900 IF(JF.EQ.' ')GO TO 53
14000 N=1
14100 DO 99 L=1,K
14200 DO 97 I=1,7
14300 IF(JD(I,L).EQ.JF)GO TO 98
14400 97 CONTINUE
14500 GO TO 99
14600 98 DO 51 M=1,11
14700 51 JA(M,N)=JA(M,L)
14800 DO 100 M=1,7
14900 JB(M,N)=JB(M,L)
15000 JC(M,N)=JC(M,L)
15100 JE(M,N)=JE(M,L)
15200 100 JD(M,N)=JD(M,L)
15300 N=N+1
15400 99 CONTINUE
15500 K=N-1
15600 53 Y='Y'
15700 TYPE 13
15800 13 FORMAT(' TTY OR LINE PRINTER?'/)
15900 ACCEPT 10,T
16000 IF(T.NE.'L')GO TO 103
16100 TYPE 88
16200 88 FORMAT(' PRINT WITH LIST NAMES?'/)
16300 ACCEPT 10,Y
16400 103 LIST=5
16500 IF(T.EQ.'L')LIST=3
16600 WRITE(LIST,91)F,JF
16700 91 FORMAT(//28XA5,' FILE',4XA1,' LIST'/)
16800 ID=1
16900 DO 45 J=1,K,2
17000 IF(K.EQ.J)ID=0
17100 WRITE(LIST,19)((JA(I,L),I=1,11),L=J,J+ID)
17200 19 FORMAT(//2(2X5A1,6A5))
17300 WRITE(LIST,46)((JB(I,L),I=1,7),L=J,J+ID)
17400 46 FORMAT(2(2X7A5))
17500 WRITE(LIST,46)((JC(I,L),I=1,7),L=J,J+ID)
17600 WRITE(LIST,46)((JE(I,L),I=1,7),L=J,J+ID)
17700 IF(Y.NE.'Y')GO TO 45
17800 WRITE(LIST,48)((JD(I,L),I=1,7),L=J,J+ID)
17900 48 FORMAT(/5X7A1,30X7A1)
18000 45 CONTINUE
18100 IF(T.EQ.'L')CALL EXIT
18200 U=1
18300 GO TO 8
18400 END
18500
18600 FUNCTION LN(M)
18700 MX=100000000
18800 LN=0
18900 DO 1 K=1,5
19000 LN=LN+NU(K,M,MX)
19100 1 MX=MX/100
19200 RETURN
19300 END
19400
19500 FUNCTION NU(K,M,MX)
19600 COMMON JA(11,200)
19700 NU=(1-('A'-JA(K,M))/536870912)*MX
19800 RETURN
19900 END